home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Prog / Q-R / QB Graphics.sea / cube3d.bas < prev    next >
BASIC Source File  |  1991-06-04  |  10KB  |  367 lines
  1. '------------------------------------------------------------------------------
  2. ' TITLE:    cube3d
  3. ' DATE:     April 19, 1991
  4. ' AUTHOR: R. Gonzalez
  5. '
  6. ' DESCRIPTION:  Demonstrates 3D perspective projection of cube.  Uses mouse
  7. '    location to determine rotation amount.  Uses a few tricks to accelerate
  8. '    performance, but note that after compilation the limiting factor is the
  9. '    Mac's graphics performance.
  10. '
  11. ' COMPILING:    Remove STATIC declarations, uncomment indicated lines
  12. '     Check: Include MBPCs & MBLCs, Include runtime code, Make all arrays static,
  13. '     Use default menu (if available: Generate 68020 & 68881 code).
  14. '
  15. ' (MODIFICATION HISTORY)
  16. ' DATE:      
  17. ' AUTHOR:  
  18. ' DESCRIPTION:  
  19. '------------------------------------------------------------------------------
  20.  
  21. ' Since mac windows use local coords (origin at top left), simplified formulas
  22. ' for 2D view transformation are used.
  23. DEF FNxv%(xw) = (xw-xw1)*(xv2%-xv1%)/(xw2-xw1)
  24. DEF FNyv%(yw) = (yw-yw1)*(yv2%-yv1%)/(yw2-yw1)
  25.  
  26. DIM SHARED xw1,xw2,yw1,yw2,xv1%,xv2%,yv1%,yv2%,d,p(4),pprime(4)
  27. DIM SHARED TRUE%,FALSE%,pi,cube.dist
  28. DIM SHARED num.points%,num.objects%,x(100),y(100),z(100),xp(100),yp(100)
  29. DIM SHARED xtemp(100),ytemp(100),ztemp(100)
  30. DIM SHARED pic1$,pic2$
  31.  
  32. 'MAIN
  33.  
  34.     DIM rot1(4,4),rot2(4,4),transl(4,4),composite(4,4),temp(4,4),yrot,xrot,junk%,mousex%,mousey%
  35.     DIM omousex%,omousey%
  36.     
  37.     TRUE% = -1
  38.     FALSE% = 0
  39.     pi = 3.14159
  40.     cube.dist = 5
  41.     xrot = 0
  42.     yrot = 0
  43.     
  44.     WINDOW CLOSE 1  'close default window
  45.  
  46.     identity rot1()
  47.     identity rot2()
  48.     'identity transl()
  49.     set.view
  50.     initialize.world
  51.     omousex% = -1    'initialize with bad value
  52.     omousey% = -1
  53.  
  54.     'animation loop (uses default QB File menu to quit)
  55.     WHILE TRUE%
  56.         junk% = MENU(0)    'must call menu(0) function to activate default menus
  57.         ' This version doesn't need these operations because the cube remains at
  58.         ' origin until just when it is ready to be drawn.
  59.         'translate 0!,0!,-cube.dist,transl()
  60.         junk% = MOUSE(0)    'must call mouse(0) to activate mouse functions
  61.         mousex% = MOUSE(1)
  62.         mousey% = MOUSE(2)
  63.         IF mousex% <> omousex% OR mousey% <> omousey% THEN     'don't redraw unless mouse moves
  64.             omousex% = mousex%
  65.             omousey% = mousey%
  66.             IF mousex% > 0 AND mousex% < (xv2%-xv1%) AND mousey% > 0 AND mousey% < (yv2%-yv1%) THEN
  67.                 yrot = ((xv2%-xv1%)/2-mousex%)*pi/(xv2%-xv1%)
  68.                 xrot = ((yv2%-yv1%)/2-mousey%)*pi/(yv2%-yv1%)
  69.             END IF
  70.             rotate.y yrot,rot1()
  71.             rotate.x xrot,rot2()
  72.             mat.mat rot1(),rot2(),composite()
  73.             'mat.mat transl(),rot(),composite()
  74.             'mat.copy temp(),composite()
  75.             'translate 0!,0!,cube.dist,transl()
  76.             'mat.mat temp(),transl(),composite()
  77.             transform.temp.world composite()
  78.             'CLS
  79.             draw.temp.world
  80.         END IF
  81.     WEND
  82.  
  83. END
  84.  
  85. '------------------------------------------------------------------------------
  86. ' transform all points in 3D world
  87. '------------------------------------------------------------------------------
  88. SUB transform.temp.world (trans()) STATIC
  89.  
  90.     'for compiler only:
  91. '    dim i%
  92.  
  93.     FOR i% = 1 TO num.points%
  94.         p(1) = x(i%)
  95.         p(2) = y(i%)
  96.         p(3) = z(i%)
  97.         p(4) = 1
  98.         vect.mat p(),trans(),pprime()
  99.         xtemp(i%) = pprime(1)
  100.         ytemp(i%) = pprime(2)
  101.         ztemp(i%) = pprime(3)
  102.     NEXT
  103.     
  104. END SUB
  105.  
  106. '------------------------------------------------------------------------------
  107. ' perform 3D projection to projection plane, then 2D view transformation to viewport
  108. '------------------------------------------------------------------------------
  109. SUB draw.temp.world STATIC
  110.  
  111.     'for compiler only:
  112. '    dim i%
  113.  
  114.     FOR i% = 1 TO num.points%
  115.         xp(i%) = xtemp(i%)*d/(ztemp(i%)+cube.dist)
  116.         yp(i%) = ytemp(i%)*d/(ztemp(i%)+cube.dist)
  117.     NEXT
  118.  
  119.     pic2$ = pic1$
  120.     
  121.     PICTURE ON
  122.     PENMODE 10    'pen mode XOR so it is erased when drawn again
  123.     MOVETO FNxv%(xp(1)),FNyv%(yp(1))    'must use Toolbox routines for XOR to work
  124.     LINETO FNxv%(xp(2)),FNyv%(yp(2))
  125.     LINETO FNxv%(xp(3)),FNyv%(yp(3))
  126.     LINETO FNxv%(xp(4)),FNyv%(yp(4))
  127.     LINETO FNxv%(xp(5)),FNyv%(yp(5))
  128.     LINETO FNxv%(xp(6)),FNyv%(yp(6))
  129.     LINETO FNxv%(xp(1)),FNyv%(yp(1))
  130.     LINETO FNxv%(xp(7)),FNyv%(yp(7))
  131.     LINETO FNxv%(xp(5)),FNyv%(yp(5))
  132.     MOVETO FNxv%(xp(3)),FNyv%(yp(3))
  133.     LINETO FNxv%(xp(7)),FNyv%(yp(7))
  134.     MOVETO FNxv%(xp(2)),FNyv%(yp(2))
  135.     LINETO FNxv%(xp(8)),FNyv%(yp(8))
  136.     LINETO FNxv%(xp(6)),FNyv%(yp(6))
  137.     MOVETO FNxv%(xp(4)),FNyv%(yp(4))
  138.     LINETO FNxv%(xp(8)),FNyv%(yp(8))
  139.     PICTURE OFF
  140.     pic1$ = PICTURE$
  141.  
  142.     'erase previous cube:
  143.     PICTURE ,pic2$
  144.  
  145.     'draw cube object:
  146.     PICTURE ,pic1$
  147.  
  148. END SUB
  149.  
  150. '------------------------------------------------------------------------------
  151. ' set parameters for 3D view transformation
  152. '------------------------------------------------------------------------------
  153. SUB set.view STATIC
  154.  
  155.     'distance from origin to projection plane:
  156.     d = 2
  157.     
  158.     'wwindow coordinates (on projection plane):
  159.     xw1 = -1
  160.     xw2 = 1
  161.     yw1 = 1
  162.     yw2 = -1
  163.  
  164.     'viewport coordinates:
  165.     xv1% = 30
  166.     yv1% = 30
  167.     xv2% = 330
  168.     yv2% = 330
  169.  
  170.     WINDOW 1,,(xv1%,yv1%)-(xv2%,yv2%),3
  171.     
  172. END SUB
  173.  
  174. '------------------------------------------------------------------------------
  175. ' initialize global objects
  176. '------------------------------------------------------------------------------
  177. SUB initialize.world STATIC
  178.  
  179.     'for compiler only:
  180. '    dim i%
  181.  
  182.     num.objects% = 1
  183.     num.points% = 8
  184.  
  185.     x(1) = 1
  186.     y(1) = 1
  187.     z(1) = 1
  188.     x(2) = 1
  189.     y(2) = 1
  190.     z(2) = -1
  191.     x(3) = 1
  192.     y(3) = -1
  193.     z(3) = -1
  194.     x(4) = -1
  195.     y(4) = -1
  196.     z(4) = -1
  197.     x(5) = -1
  198.     y(5) = -1
  199.     z(5) = 1
  200.     x(6) = -1
  201.     y(6) = 1
  202.     z(6) = 1
  203.     x(7) = 1
  204.     y(7) = -1
  205.     z(7) = 1
  206.     x(8) = -1
  207.     y(8) = 1
  208.     z(8) = -1
  209.  
  210.     'FOR i% = 1 TO num.points%
  211.     '    z(i%) = z(i%) + cube.dist    'move object away from origin/eye location
  212.     'NEXT
  213.     
  214. END SUB
  215.  
  216. '------------------------------------------------------------------------------
  217. ' multiply two 4x4 matrices - produces a 4x4 matrix
  218. '------------------------------------------------------------------------------
  219. SUB mat.mat (a(),b(),mresult()) STATIC
  220.  
  221.     'for compiler only:
  222. '    dim r%,c%
  223.  
  224.     FOR r% = 1 TO 4
  225.         FOR c% = 1 TO 4
  226.             mresult(r%,c%) = a(r%,1)*b(1,c%)+a(r%,2)*b(2,c%)+a(r%,3)*b(3,c%)+a(r%,4)*b(4,c%)
  227.         NEXT
  228.     NEXT
  229.     
  230. END SUB
  231.  
  232. '------------------------------------------------------------------------------
  233. ' copy a 4x4 matrix
  234. '------------------------------------------------------------------------------
  235. SUB mat.copy (a(),b()) STATIC
  236.  
  237.     'for compiler only:
  238. '    dim r%,c%
  239.  
  240.     FOR r% = 1 TO 4
  241.         FOR c% = 1 TO 4
  242.             a(r%,c%) = b(r%,c%)
  243.         NEXT
  244.     NEXT
  245.  
  246. END SUB
  247.  
  248. '------------------------------------------------------------------------------
  249. ' multiply 4-vector by 4x4 matrix - produces a 4-vector
  250. '------------------------------------------------------------------------------
  251. SUB vect.mat (v(),m(),vresult()) STATIC
  252.  
  253.     'for compiler only:
  254. '    dim c%
  255.  
  256.     FOR c% = 1 TO 4
  257.         vresult(c%) = v(1)*m(1,c%)+v(2)*m(2,c%)+v(3)*m(3,c%)+v(4)*m(4,c%)
  258.     NEXT
  259.     
  260. END SUB
  261.  
  262. '------------------------------------------------------------------------------
  263. ' create 4x4 identity matrix
  264. '------------------------------------------------------------------------------
  265. SUB identity (m()) STATIC
  266.  
  267.     'for compiler only:
  268. '    dim r%,c%
  269.  
  270.     FOR r% = 1 TO 4
  271.         FOR c% = 1 TO 4
  272.             IF r% = c% THEN
  273.                 m(r%,c%) = 1
  274.             ELSE
  275.                 m(r%,c%) = 0
  276.             END IF
  277.         NEXT
  278.     NEXT
  279.  
  280. END SUB
  281.  
  282. '------------------------------------------------------------------------------
  283. ' create 4x4 transformation matrix for rotation about x axis
  284. ' (assumes m is initially the identity matrix or a former rotate.x matrix)
  285. '------------------------------------------------------------------------------
  286. SUB rotate.x (theta,m()) STATIC
  287.  
  288.     'for compiler only:
  289. '    dim ct,st
  290.  
  291.     'calculate these only once for efficiency:
  292.     ct = COS(theta)
  293.     st = SIN(theta)
  294.  
  295.     m(2,2) = ct
  296.     m(2,3) = st
  297.     m(3,2) = -st
  298.     m(3,3) = ct
  299.  
  300. END SUB
  301.  
  302. '------------------------------------------------------------------------------
  303. ' create 4x4 transformation matrix for rotation about y axis
  304. ' (assumes m is initially the identity matrix or a former rotate.y matrix)
  305. '------------------------------------------------------------------------------
  306. SUB rotate.y (theta,m()) STATIC
  307.  
  308.     'for compiler only:
  309. '    dim ct,st
  310.  
  311.     'calculate these only once for efficiency:
  312.     ct = COS(theta)
  313.     st = SIN(theta)
  314.  
  315.     m(1,1) = ct
  316.     m(1,3) = -st
  317.     m(3,1) = st
  318.     m(3,3) = ct
  319.  
  320. END SUB
  321.  
  322. '------------------------------------------------------------------------------
  323. ' create 4x4 transformation matrix for rotation about z axis
  324. ' (assumes m is initially the identity matrix or a former rotate.z matrix)
  325. '------------------------------------------------------------------------------
  326. SUB rotate.z (theta,m()) STATIC
  327.  
  328.     'for compiler only:
  329. '    dim ct,st
  330.  
  331.     'calculate these only once for efficiency:
  332.     ct = COS(theta)
  333.     st = SIN(theta)
  334.  
  335.     m(1,1) = ct
  336.     m(1,2) = st
  337.     m(2,1) = -st
  338.     m(2,2) = ct
  339.  
  340. END SUB
  341.  
  342. '------------------------------------------------------------------------------
  343. ' create 4x4 transformation matrix for translation
  344. ' (assumes m is initially the identity matrix or a former translation matrix)
  345. '------------------------------------------------------------------------------
  346. SUB translate (tx,ty,tz,m()) STATIC
  347.  
  348.     m(4,1) = tx
  349.     m(4,2) = ty
  350.     m(4,3) = tz
  351.  
  352. END SUB
  353.  
  354. '------------------------------------------------------------------------------
  355. ' create 4x4 transformation matrix for scaling
  356. ' (assumes m is initially the identity matrix or a former scaling matrix)
  357. '------------------------------------------------------------------------------
  358. SUB scale (sx,sy,sz,m()) STATIC
  359.  
  360.     m(1,1) = sx
  361.     m(2,2) = sy
  362.     m(3,3) = sz
  363.  
  364. END SUB
  365.  
  366.  
  367.